\ Track which names are currently available.

\ The node structure contains a link field, the package name, and
\ optionally the package specification filename.

: pkg-name-len ( addr -- addr' )  cell+ ;
: pkg-filename-len ( addr -- addr' )  2 cells + ;
: /pkg-name ( -- u )  3 cells ;
: pkg-name-str ( addr -- addr' ) /pkg-name + ;
	: !pkg-name ( c-addr u addr -- )
		2dup pkg-name-len !  pkg-name-str swap chars move ;
	: @pkg-name ( addr -- c-addr u )
		dup pkg-name-str swap pkg-name-len @ ;
: pkg-filename ( addr -- addr' )  @pkg-name chars + ;
	: !pkg-filename ( c-addr u addr -- )
		2dup pkg-filename-len ! pkg-filename swap chars move ;
	: @pkg-filename ( addr -- c-addr u )
		dup pkg-filename swap pkg-filename-len @ ;

: pkg-size ( u -- u' )  chars /pkg-name + ;
: pkg-mem ( addr -- addr u )
	dup pkg-filename-len @ over pkg-name-len @ + pkg-size ;
: pkg-end ( addr -- addr' )  pkg-mem + ;
: pkg-name, ( c-addr u -- addr )
	align here over pkg-size allot
	0 over pkg-filename-len !  dup >r !pkg-name r> ;

: listed-pkg? ( c-addr u addr -- flag )
	begin @ dup while
		3dup @pkg-name str= until
	then 0<> nip nip ;

\ We keep a linked list of packages which have been loaded.

variable pkgs-available  0 pkgs-available !
: supplied ( c-addr u -- )  pkg-name, pkgs-available link-after ;
: supply ( "...<cr>" -- )  parse-line supplied ;
: supplied? ( c-addr u -- flag )  pkgs-available listed-pkg? ;

\ We also keep a list of packages which we have seen (for loop
\ detection) and a queue of packages which we have chosen for loading.

variable pkgs-seen  0 pkgs-seen !
queue pkgs-chosen

: pkg-spec-seen? ( c-addr u -- flag )
	pkgs-seen begin @ dup while
		3dup @pkg-filename str= until
	then 0<> nip nip ;
: pkg-chosen? ( c-addr u -- flag )
	2dup pkgs-chosen listed-pkg? ?dup if nip nip else
	supplied? then ;

\ These go in a temporary buffer.

create tmp-base 4096 allot  here constant end-tmp
variable tmp-fence  tmp-base tmp-fence !
: unused-tmp ( -- u )  end-tmp tmp-fence @ - ;
: align-tmp ( -- )  tmp-fence dup @ aligned swap ! ;
: allot-tmp ( u -- addr )
	dup unused-tmp u> abort" temp buffer overflow"
	tmp-fence tuck @ tuck + rot ! ;

: pkg-seen ( c-addr.file u c-addr.pkg u -- addr )
	2over nip over + pkg-size  align-tmp allot-tmp
	dup >r !pkg-name r@ !pkg-filename r>
	dup pkgs-seen link-after ;
: choose-package ( addr.pkg -- )
	dup pkgs-chosen enqueue  @ pkgs-seen ! ;
: pkg-loaded ( addr.pkg -- )
	pkg-mem align allot-data  pkgs-available link-after ;

\ We also use the temporary buffer to hold backtracking information:

: mark ( -- addr )
	tmp-fence @  align-tmp 4 cells allot-tmp
	tuck !  pkgs-seen @ over cell+ !
	dup pkgs-chosen 2@ rot 2 cells + 2! ;
: backtrack ( addr -- )
	dup 2 cells + 2@ pkgs-chosen 2!
	dup cell+ @ pkgs-seen !  @ tmp-fence !  ;
